home *** CD-ROM | disk | FTP | other *** search
/ Interplay's Learn to Program Basic (Review Copy) / Learn to Program Basic Review Copy (Interplay)(June 23, 1998).ISO / pc / ltpbasic / projects / towers.bas < prev    next >
BASIC Source File  |  1998-03-02  |  4KB  |  223 lines
  1. Rem Towers of Hanoi
  2. Rem By Richard The Rappa
  3.  
  4. Rem Set the number of rings
  5. rings = 3
  6.  
  7. Dim pin(rings+1,3)
  8.  
  9. Dim pinx(3)
  10. Dim piny(3)
  11. Dim ringcolor(10)
  12.  
  13. Rem Do instructions
  14. Gosub Instructions
  15.  
  16. Cls
  17. Color 235
  18. Background "Peg"
  19.  
  20. Rem Read in ring colors and coordinate data
  21. for clr = 1 to 10
  22. Read ringcolor(clr)
  23. next clr
  24.  
  25. For t = 1 to 3
  26. Read pinx(t)
  27. Read piny(t)
  28. Next t
  29.  
  30. data 126,94,54,64,70,80,40,104,113,30
  31. data 65,150,165,150,265,150
  32.  
  33. Rem Initialize the pins
  34. for t = 1 to rings
  35. pin(rings - t+1, 1) = t
  36. next t
  37.  
  38. turns = 0
  39. first = 0
  40. second = 0
  41. result = 0
  42.  
  43. Rem Main Loop
  44. While pin(rings,3) = 0
  45. Rem Draw rings
  46. Gosub Update
  47. Rem Get player move
  48. Gosub GetMove
  49. Rem Move the rings
  50. Gosub RingMove
  51. if result = 0 then
  52. Rem There was an error
  53. Sound "GameShow"
  54. TextColor 126 
  55. Rem Show the error message
  56. Position 20-Len(error$)/2,12
  57. Print error$
  58. sleep 15
  59. Rem Remove the error message
  60. Position 0,12
  61. Print "                                        "
  62.  
  63. else
  64. turns = turns + 1
  65. endif
  66. Wend
  67. Gosub Update
  68. a$ = "You won in "+str$(turns)+" moves"
  69. Sound "Victory"
  70. Banner a$
  71. End
  72.  
  73. Rem Get first and second peg for movement
  74. Rem from user keypress of 1, 2, or 3
  75. Rem or 'Q' to quit game
  76. GetMove:
  77. Rem do this twice
  78. for t = 1 to 2
  79. Rem Prompt for first peg
  80. If t = 1 then
  81. TextColor 173
  82. Home
  83. Print
  84. Print " Press Source     "
  85. else
  86. Rem Prompt for second peg
  87. TextColor 173
  88. Home
  89. Print
  90. Print " Press Destination"
  91. Endif
  92. Rem Get the keystroke
  93. a$ = ""
  94. While a$ <> "1" and a$ <> "2" and a$ <> "3" and a$ <> "q"
  95. a$ = inkey$
  96. Wend
  97. if a$ = "q" then end
  98. if a$ = "1" then sel = 1
  99. if a$ = "2" then sel = 2
  100. if a$ = "3" then sel = 3
  101. Rem If getting first peg
  102. if t = 1 then
  103. first = sel
  104. else
  105. Rem Getting second peg
  106. second = sel
  107. endif
  108. next t
  109.  
  110.  
  111. Rem Update the pictures for all the rings on the pegs
  112. Update:
  113.  
  114. Background "Peg"
  115.  
  116. xadder = 20 / rings
  117. yadder = 100 / rings
  118.  
  119. For t = 1 to 3
  120.  
  121. Rem Draw the rings over that peg
  122. For z = rings to 1 step -1
  123. if pin(z,t) <> 0 then
  124. clr = ringcolor(pin(z,t))
  125. x1 = pinx(t) - 10 - (xadder*pin(z,t))
  126. x2 = pinx(t) + 10 + (xadder*pin(z,t))
  127. y1 = piny(t) - (yadder * z) - 20
  128. y2 = piny(t) - (yadder * z) - 10
  129. Gosub RenderObject
  130. endif
  131. Next z
  132. Next t
  133.  
  134. return
  135.  
  136. Rem Check to see if a ring can be moved, and if so, move it
  137. RingMove:
  138. choice1 = 0
  139. index1 = 1
  140. choice2 = 0
  141. index2 = 1
  142. result = 0
  143.  
  144. Rem Find the top ring of the source peg
  145. for z = 1 to rings
  146. if pin(z,first) <> 0 then 
  147. choice1 = pin(z,first)
  148. index1 = z
  149. endif
  150. next z
  151.  
  152. Rem Find the top ring of the destination peg
  153. for z = 1 to rings
  154. if pin(z,second) <> 0 then
  155. choice2 = pin(z,second)
  156. index2 = z
  157. endif
  158. next z
  159.  
  160. Rem If the next pin is empty, put the ring there
  161. if choice2 = 0 then
  162. pin(index2,second) = pin(index1,first)
  163. pin(index1,first) = 0
  164. result = 1
  165. else
  166. Rem If the topmost ring is bigger than the ring we're moving, place the ring
  167. if choice2 > choice1 then
  168. pin(index2+1,second) = pin(index1,first)
  169. pin(index1,first) = 0
  170. result = 1
  171. endif
  172. endif
  173. Rem If we couldn't place the ring, say why
  174. If result = 0 Then
  175. If first = second then
  176. error$ = "You must choose two different pegs!"
  177. Else
  178. error$ = "Rings on top must be smaller!"
  179. Endif
  180. Endif
  181. return
  182.  
  183. Rem Render a ring
  184. RenderObject:
  185. increment = 0
  186. for yy = y1 to y2
  187. Color clr + increment
  188. increment = increment + .5
  189. Line x1,yy to x2,yy
  190. next yy
  191. return
  192.  
  193. Instructions:
  194. Cls
  195. color 235
  196. FillRect 0,0 to 320,240
  197. TextColor 95
  198. Print "Towers Of Hanoi"
  199. Print
  200. TextColor 21
  201. Print "The object is to move all the rings from"
  202. Print "Peg 1 onto Peg 3. You can move the rings"
  203. Print "between any two pegs, but you can NEVER"
  204. Print "put a larger ring over a smaller one."
  205. Print
  206. TextColor 156
  207. Print "Press 1,2, or 3 to select the top ring"
  208. Print "from the chosen peg, then press 1,2, or"
  209. Print "3 again to select where it's going."
  210. Print
  211. Print "Press 'Q' at any time to quit."
  212. Print
  213. TextColor 166 
  214. Print "Press a key when ready"
  215. While inkey$ = ""
  216. Wend
  217. return
  218.  
  219.  
  220.  
  221.  
  222.